(ql:quickload '(defclass-std parachute alexandria))
 
(defpackage :lexer
  (:use :cl :defclass-std :parachute))
 
(in-package :lexer)
 
(defun string-add (string char)
    (format nil "~A~A" string char))
 
(defclass/std token ()
    ((str pos)))
 
(defun make-token (string position)
    (make-instance 'token :str string :pos position))

(defmacro push-new-token (string position token-list)
    `(push (make-token ,string
                       ,position)
           ,token-list))
 
(defun lexer (code-string)
    (let ((tokens nil)
          (state :simple)
          (current-token-position 0)
          (current-token-string ""))
        (loop :for pos :from 0
              :for char :across code-string
              :do (case state
                    ((:simple)
                     (case char
                       ((#\Space #\Newline) )
                       
                       (( #\) )
                        (push-new-token ")" pos tokens))
                       
                       (( #\( )
                        (push-new-token "(" pos tokens))

                       (( #\; )
                        (setf state :in-comment))
                       
                       (otherwise
                        (setf current-token-position pos
                              current-token-string   (string-add current-token-string
                                                                 (char-upcase char)))
                        (setf state :in-token))))

                    ((:in-comment)
                     (case char
                       ((#\Newline)
                        (setf state :simple))))
                    
                    ((:in-token)
                     (case char
                       ((#\Space)
                        (push-new-token current-token-string
                                        current-token-position
                                        tokens)
                        (setf current-token-string ""
                              state                :simple))
                       
                       ((#\Newline)
                        (push-new-token current-token-string
                                        current-token-position
                                        tokens)
                        (setf current-token-string ""
                              state                :simple))
                       
                       (( #\( )
                        (push-new-token current-token-string
                                        current-token-position
                                        tokens)
                        (push-new-token "(" pos tokens)
                        (setf current-token-string ""
                              state                :simple))
                       
                       (( #\) )
                        (push-new-token current-token-string
                                        current-token-position
                                        tokens)
                        (push-new-token ")" pos tokens)
                        (setf current-token-string ""
                              state                :simple))

                       (( #\; )
                        (push-new-token current-token-string
                                        current-token-position
                                        tokens)
                        (setf current-token-string ""
                              state                :in-comment))
                       
                       (otherwise
                        (setf current-token-position pos
                              current-token-string   (string-add current-token-string
                                                                 (char-upcase char))))))))
        
        (when (eql state :in-token)
            (push-new-token current-token-string
                            current-token-position
                            tokens))
        (nreverse tokens)))
 
 
(defun lexer-token-strings (code-string)
    (loop for token in (lexer code-string)
          collect (str token)))
 
(define-test lexer
    (is equal
        '("(" ")")
        (lexer-token-strings "()"))
 
    (is equal
        '("(" "+" "1" "2" "3" ")")
        (lexer-token-strings "(+ 1 2 3)"))

    (is equal
        '("QWERTY" "ЙЦУКЕН")
        (lexer-token-strings "qwerty йцукен"))

    (is equal
        '("QWERTY")
        (lexer-token-strings "
qwerty"))

    (is equal
        '("(" "LOOP" "FOR" "I" "FROM" "1" "TO" "10" "COLLECT" "(" "*" "I" "I" ")" ")")
        (lexer-token-strings "(loop for i from 1 to 10
   collect (* i i))"))

    (is equal
        '("(" ")")
        (lexer-token-strings "( ; Comment
)"))

    )
